00100	TITLE FLIP
00200	EXTERNAL FIX1A,NUMVAL,CONS,FLONUM,MAKNUM,SQRT,ATAN,SIN,COS
00300	INTERNAL NOW,DRUMO,DRUMI,DRUMZ
00400	INTERNAL PFLIP,PSET,PZIP,PNOT,PXOR,PIOR,PAND,PEQU,PNOR
00500	INTERNAL LOGIC,HISTO,SIEVE,HISTOV
00600	INTERNAL PACK,XMINW,AREA,YMIN,YMAX,SUMY
00700	INTERNAL SUMSQY,SUMX,SUMSQX,PAC,STOPWAR,INARDS
00800	INTERNAL COLORS,TSINIT,LENS,SWS,ZIP,TV,TVADD,TVSUB,ADDC
00900	INTERNAL IMULC,GRAD,PAN,FOCUS,TILT,PPP,TTT,FFF,HISTOP
01000	INTERNAL DAC,ARM,JOINT,JOY,SEED,BLIT,XYFLIP
01100	INTERNAL BLOT,LSD
01200	OPDEF CALL[34B8]
01300	OPDEF JCALL[35B8]
01400	OPDEF SPCWAR[43B8]
01500	OPDEF OUTCHR[XWD 51040,0]
01600	OPDEF INUM[SUBI 3577777]
01700	OPDEF PTYGET[711B8]
01800	OPDEF PTWR1W[71134B14]
01900	OPDEF PTWRS7[71144B14]
02000	OPDEF PTSETL[711B11]
02100	OPDEF OUTSTR[5114B14]
02200	A←1
02300	B←2
02400	C←3
02500	D←4
02600	E←5
02700	F←6
02800	G←7
02900	H←10
03000	I←←4
03100	J←←5
03200	K←←6
03300	L←←7
03400	P←14
03500	NPAC←25
04600	;HISTOGRAM VECTORS
04700	HISTOV:	0
04800	BLOCK 110
04900	;PICTURE ACCUMULATORS
05000	PAC:	0
05100	BLOCK 220*NPAC
     

00100	;VIDICON INPUT BUFFER
00200	TVBUF:	0
00300	BLOCK 1100
00350	
00352	;COLOR BYTE POINTERS
00354	CBPTR:	POINT 9,COLORS,8
00356		POINT 9,COLORS,17
00358		POINT 9,COLORS,26
00360		POINT 9,COLORS,35
00400	BLOCK 110
00500	;COLOR IMAGE ARITHMETIC AREA
00600	COLORS:	0
00700	BLOCK 110*110
00800	BLOCK 110
00900	WIDTH←←40
01000	XLOTV←←24
01100	XHITV←←XLOTV+WIDTH*11
01200	YLOTV←←24
01300	YHITV←←374
01400	VOLUME←←(YHITV-YLOTV)*WIDTH
01500	
01600	PING:	0
01700	BCLIP:	7
01800	TCLIP:	0
01900	BITS:	4
02000	IWID:	WIDTH*11
02100	LINLEN:	WIDTH
02200	FLINE:	YLOTV
02300	LLINE:	YHITV-1
02400	LSIDE:	XLOTV
02500	RSIDE:	XHITV-1
02600		VOLUME
02700	DSKBUF:	0
02800		BLOCK WIDTH*440
02900	
03000	CWI←<BYTE(9) XLOTV,YLOTV,4,4>
03200	;CAMERA - WINDOWS.
03300	CWTV:	CWI
03400	CWCOLR:	CWI↔CWI↔CWI↔CWI
03500	CWPAC:	FOR I←0,NPAC <CWI
03600	>
03800	;SIEVE - BOUNDS.
03900	SBPAC:	0
04000		BLOCK NPAC
04100
04200	Q←577777
04400	;(NOW) RETURNS TIME OF DAY IN 1/60'S OF A SECOND.
04500	NOW:	CALLI 1,22
04600		JCALL 1,FIX1A
05000	PACPTR:	FOR I←0,NPAC<I*220
05100	>
05200	PACPAC:	FOR I←0,NPAC<PAC+I*220
05300	>
05400	FOR @$ I←0,NPAC<PAC$I←PAC+I*220
05500	>
05600
     

00100	;BORROW TRIG FUNCTIONS FROM THE FORTRAN LIBRARY AND LINK TO LISP.
00200	DEFINE FUN (LTAG,FTAG)
00300	{
00400	LTAG:	CALL 1,NUMVAL
00500		MOVEM A,ARG#
00600		JSR ACPUT
00700		JSA 16,FTAG
00800		JUMP 2,ARG
00900		MOVEM ARG
01000		JSR ACGET
01100		MOVE A,ARG
01200		MOVEI B,FLONUM
01300		JCALL 2,MAKNUM
01400	}
01500	FUN(SQR,SQRT)
01600	FUN(ARCTAN,ATAN)
01700	FUN(SINE,SIN)
01800	FUN(COSINE,COS)
     

00100	;(TV Z)
00200	TV:	CALL 1,NUMVAL
00300		MOVEM A,TVZ
00400		MOVEM A,PINGZ#	;SAVE CLIPS FOR PINGLE .DAT FILE OUTPUT.
00500		
00600		MOVE  A,[XWD -VOLUME,DSKBUF]
00700		MOVEM A,TVPTR
00800	
00900		MOVE  A,[BYTE(9)YLOTV,XLOTV,WIDTH]
01000		MOVEM A,TVYXW
01100	
01200		JRST TAKETV
01300	
01400	;(TVWEE X Y Z)
01500	TVWEE:	INUM 1,
01600		INUM 2,
01700		MOVEI 4,10B26
01800		DPB 1,[POINT 9,4,17]	;X
01900		DPB 2,[POINT 9,4,8]	;Y
02000		MOVEM 4,TVYXW
02100	
02200		MOVE A,[XWD -1100,TVBUF]
02300		MOVEM A,TVPTR
02400	
02500		MOVE 1,3
02600		CALL 1,NUMVAL
02700		MOVEM A,TVZ
02800		JRST TAKETV
02900	
03000	;TAKE A TV PICTURE, AND CONVERT GREY CODE.
03100	TAKETV:	INIT 17,17
03200		SIXBIT/TV/
03300		0	;NO BUFFERING
03400		JRST [OUTSTR [ASCIZ /CAN'T INIT TV./]↔SETZ 1,↔POPJ P,]
03500		SETZM TVERR
03600		INPUT 17,[
03700	TVPTR:	XWD -VOLUME,DSKBUF
03800	TVZ:	0	;BOTTOM CLIP, TOP CLIP, CAMERA, VERTICAL AND HORIZONTAL.
03900	TVYXW:	BYTE(9)YLOTV,XLOTV,WIDTH
04000	TVERR:	0]	;ERRORS
04100	
04200		MOVE A,TVERR
04300		TRNE A,100060
04400		JRST [TRNE A,100000
04500		OUTSTR [ASCIZ/TV PARITY ERROR.
04600	/]↔	TRNE A,40
04700		OUTSTR [ASCIZ/TV DATA MISS.
04800	/]↔	TRNE A,20
04900		OUTSTR [ASCIZ/TV NON EX MEM ERROR BIT.
05000	/]↔	JRST .+1]
     

00100	;CONVERT GREY CODE.
00200		JSR ACPUT
00300		HRLZI 16,[
00400			SETCM 17,(16)	;0
00500			MOVE  15,17	;1
00600			LSH   15,-1	;2
00700			AND   15,13	;3
00800			XORB  17,15	;4
00900			LSH   15,-2	;5
01000			AND   15,14	;6
01100			XOR   17,15	;7
01200			MOVEM 17,(16)	;10
01300			AOBJN 16,	;11
01400			JRST TVEXIT-1	;12
01500			BYTE (4)7,7,7,7,7,7,7,7,7	;13
01600			BYTE (4)3,3,3,3,3,3,3,3,3	;14
01700			]
01800		BLT 16,14
01900		MOVE 16,TVPTR
02000		JRST
02100	
02200		JSR ACGET
02300	TVEXIT:	CALLI 1,22
02400		MOVEM 1,TCLIP
02500		JCALL 1,FIX1A
02600	
02700	;(DISKO SERIES SERIAL)
02800	DISKO:	LDB   C,[POINT 3,PINGZ,20]
02900		MOVEM C,BCLIP
03000		LDB   C,[POINT 3,PINGZ,23]
03100		MOVEM C,TCLIP
03200		TROA  C,1
03300	;(DISKI SERIES SERIAL)
03400	DISKI:	SETZ C,
03500		DPB C,[POINT 1,DISK1,8]
03600		DPB C,[POINT 1,DISK2,8]
03700	
03800		INUM A,
03900		INUM B,
04000		ROT B,-3*5
04100		FOR I←1,5{
04200		ROT A,3
04300		IORI A,2
04400		ROTC A,3}
04500		MOVEM A,[DSKNAM: 0↔SIXBIT/DAT/↔0↔0]
04600		SETZM DSKNAM+2↔SETZM DSKNAM+3↔HLLZS DSKNAM+1
04700	
04800		INIT 3,17
04900		SIXBIT/DSK/
05000		0;NO BUFFERS
05100		JRST [OUTSTR [ASCIZ /DISK INIT FAILED./]↔SETZ 1,↔POPJ P,]
05200	
05300	DISK1:	LOOKUP 3,DSKNAM
05400		JRST [OUTSTR [ASCIZ /DISK FILENAME ERROR./]↔SETZ 1,↔POPJ P,]
05500	
05600	DISK2:	INPUT 3,[XWD -(VOLUME+13),PING  ↔  0]
05700		CLOSE 3,
05800		RELEASE 3,
05900		SETZ 1,
06000		POPJ P,
06100	
06200	OPDEF DRUM[707B8]
06300	;(DRUMO BAND SECTOR)
06400	DRUMO:	TROA C,1
06500	;(DRUMI BAND SECTOR)
06600	DRUMI:	SETZ C,
06700		DPB C,[POINT 1,DRUMOP,8]
06800		INUM A,
06900		INUM B,
07000		ANDI A,37
07100		ANDI B,7
07200		IMULI B,460
07300		MOVEM B,SECTOR
07400	DRUMOP:	DRUM A,[PING
07500			VOLUME+20
07600	SECTOR:		0]
07700		JRST [CALLI A,400011	;RELEASE BAD BAND
07800		      CALLI A,400010	;GET A GOOD BAND
07900		      JRST [OUTSTR [ASCIZ /DRUM BAND FAILURE.
08000	/]↔		    JRST .+1]
08100		      JRST .-1]
08200		SETZ 1,
08300		POPJ P,
08400	
08500	;(DRUMZ)
08600	DRUMZ:	CALLI 400012
08700		SETZ 1,
08800		POPJ P,
     

00100	;(WINDOW X Y DX DY)
00200	WINDOW:	INUM A,
00300		INUM B,
00400		INUM C,
00500		INUM D,
00600		;SET TVBUF'S CAMERA-WINDOW.
00700		MOVEM D,CWTV
00800		HRLM  B,CWTV
00900		DPB  A,[POINT 9,CWTV,8]
01000		DPB  C,[POINT 9,CWTV,26]
01100		SUBI A,XLOTV
01200		SUBI B,YLOTV
01300	TVBPTR←←1
01400	DSKPTR←←2
01500	
01600		JSR ACPUT
01700		MOVE A		;X/9 QUOTIENT IN 0
01800		IDIVI 11	;X/9 REMAINDER IN 1
01900		IMULI DSKPTR,WIDTH
02000		ADDI DSKPTR,DSKBUF
02100		ADD  DSKPTR,	;(Y*WIDTH) + (ADDR OF DSKBUF) + (QUOTIENT OF X/9)
02200	
02300		MOVNS 1		;FORM P&S BITS FROM REMAINDER OF X/9.
02400		ADDI 1,10
02500		ROT 1,16
02600		IORI 1,400	;  <POINT 4,ADDR,4*(REMAINDER OF X/9) >
02700	
02800		HRRM 3,PMDX	;PROG MOD DX
02900	
03000		IMULI 3,10	;FORM DYGAP IN 4
03100		IMULI 4,WIDTH
03200		SUB 4,3
03400	MOVE [XWD[
03500			MOVEI 3,107	;5  INNER LOOP COUNTER
03600	UNW1:		LDB DSKPTR	;6  MEM-CYC	FROM DSKBUF
03700	UNW2:		IDPB TVBPTR	;7  MEM-CYC	 TO  TVBUF
03800	PMDX:		MOVEI		;10 DX-LOOP	-PROG MOD DX
03900			IBP DSKPTR	;11
04000			SOJG 11		;12
04100			SOJGE 3,6	;13 LOOP-INNER
04200			HRLI DSKPTR,	;14		-PROG MOD ORIGINAL P&S BITS.
04300			ADDI DSKPTR,	;15		-PROG MOD DY GAP.
04400			SOJGE 4,5	;16 LOOP-OUTER
04500			JRST [JSR ACGET↔SETZ 1,↔POPJ P,]],5]
04600		BLT 17
04700		HRR 14,1
04800		HRR 15,4
04900		MOVE TVBPTR,[POINT 4,TVBUF]
05000		MOVEI 4,107
05100		HRL DSKPTR,14
05200		JRST 5
     

00100	;(UNWIND X Y DX DY)
00200	UNWIND:	MOVE E,[ILDB TVBPTR]
00300		MOVEM E,UNW1
00400		MOVE  E,[DPB DSKPTR]
00500		MOVEM E,UNW2
00600		PUSHJ P,WINDOW
00700		MOVE E,[LDB DSKPTR]
00800		MOVEM E,UNW1
00900		MOVE E,[IDPB TVBPTR]
01000		MOVEM E,UNW2
01100		POPJ P,
01200	
01300	
01400	;(TVMOVE N)
01500	TVMOVE:	MOVE B,CWTV		;CHANGE CAMERA WINDOW OF COLOR N.
01550		MOVEM B,CWCOLR-Q(A)
01575		MOVE A,CBPTR-Q(A)
01600		MOVE B,[POINT 4,TVBUF]
01700		MOVE C,[XWD[
01800			ILDB C,B	;5  GET FROM TVBUF
01900			DPB  C,A	;6  PUT  IN  COLORS
02000			AOS A		;7
02100			SOJG  D,5	;10
02200			SETZ 1,		;11
02300			POPJ P,		;12
02400			],5]
02500		BLT C,12
02600		MOVEI D,110*110
02700		JRST E
02800	;(TVPACK N)
02900	TVPACK:	MOVE A,CBPTR-Q(A)
03000		MOVE B,[POINT 4,TVBUF]
03100		MOVE C,[XWD[
03200			LDB C,A	;5  GET FROM TVBUF
03300			IDPB  C,B	;6  PUT  IN  COLORS
03400			AOS A		;7
03500			SOJG  D,5	;10
03600			SETZ 1,		;11
03700			POPJ P,		;12
03800			],5]
03900		BLT C,12
04000		MOVEI D,110*110
04100		JRST E
04200	
04300	
     

04400	;(TVADD N)
04500	TVADD:	MOVEM TEMP#
04600		MOVE A,CBPTR-Q(A)
04700		MOVE B,[POINT 4,TVBUF]
04800		MOVE C,[XWD[
04900			ILDB B		;5  GET FROM TVBUF
05000			LDB C,A		;6  GET FROM COLORS
05100			ADD C,		;7
05200			DPB C,A		;10  PUT  IN  COLORS
05300			AOS  A		;11
05400			SOJG D,5	;12
05500			JRST .+4	;13
05600			],5]
05700		BLT C,13
05800		MOVEI D,110*110
05900		JRST E
06000		MOVE TEMP
06100		SETZ 1,
06200		POPJ P,
06300	
06400	;(TVSUB N)
06500	TVSUB:	MOVEM TEMP
06600		MOVE A,CBPTR-Q(A)
06700		MOVE B,[POINT 4,TVBUF]
06800		MOVE C,[XWD[
06900			ILDB B		;5  GET FROM TVBUF
07000			LDB C,A		;6  GET FROM COLORS
07100			SUB C,		;7
07200			DPB C,A		;10  PUT  IN  COLORS
07300			AOS  A		;11
07400			SOJG D,5	;12
07500			JRST .+4	;13
07600			],5]
07700		BLT C,13
07800		MOVEI D,110*110
07900		JRST E
08000		MOVE TEMP
08100		SETZ 1,
08200		POPJ P,
08300	
     

00100	;(LOGIC A B N)
00200	LOGIC:	INUM C,
00300		MOVE A,[FOR I←0,NPAC< MOVE 11,PAC+I*220↔>]-Q(A)
00400		MOVE B,[FOR I←0,NPAC<SETZM 11,PAC+I*220↔>]-Q(B)
00500		DPB  C,[POINT 4,B,6]
00600		MOVEI 10,217
00700		MOVE  11,[XWD[AOS 1↔AOS 2↔SOJGE 10,1↔SETZ 1,↔POPJ P,],3]
00800		BLT 11,7
00900		JRST 1
01000	DEFINE LOGOP (N) {
01100		MOVEI C,N
01200		JRST LOGIC+1}
01300	PFLIP:	MOVE B,A ↔ LOGOP 12
01400	PSET:	MOVE A,PACPAC-Q(A)
01500		SETOM 0(A)
01600		JRST PZIP+2
01700	PZIP:	MOVE A,PACPAC-Q(A)
01800		SETZM 0(A)
01900		HRL A,A
02000		HRRZ B,A
02100		AOS A
02200		ADDI B,217
02300		BLT A,@B
02301		SETZ 1,
02302		POPJ P,
02351	AONLY:	LOGOP 4
02375	BONLY:	LOGOP 2
02400	PNOT:	MOVE D,CWPAC-Q(A)
02450		MOVEM D,CWPAC-Q(B)
02475		LOGOP 12
02500	PXOR:	LOGOP 6
02600	PIOR:	LOGOP 7
02700	PAND:	LOGOP 1
02800	PEQU:	LOGOP 11
02900	BIMPA:	LOGOP 15
02950	ABIMP:	LOGOP 13
03000	PNOR:	LOGOP 16
03100	NAND:	LOGOP 10
03200	;HISTOGRAMS FROM COLORS (HISTO N)
03300
03400	HISTO:	INUM A,
03500		MOVNS A
03600		HLLI A,
03700	
03800		SETZM HISTOV		;CLEAR HISTOGRAM VECTORS
03900		MOVE B,[XWD HISTOV,HISTOV+1]
04000		BLT B,HISTOV+107
04100
04200		MOVEI J,110*110-1
04300		MOVE B,COLORS(J)	;GET BYTES 0,1,2,3
04400		ROT B,@A
04500
04600		LDB C,[POINT 4,B,8]	;INCREMENT
04700		AOS HISTOV(C)		;COLOR 0
04800		LDB C,[POINT 4,B,17]
04900		AOS HISTOV+20(C)	;COLOR 1
05000		LDB C,[POINT 4,B,26]
05100		AOS HISTOV+40(C)	;COLOR 2
05200		ANDI B,17
05300		AOS HISTOV+60(B)	;COLOR 3
05400
05500		SOJGE J,.-12
05600
05700		SETZ A,
05800		POPJ P,
     

00100	;(HISTOP PAC) ADDS TO HISTOGRAM FOR ONLY THE  POINTS IN PAC
00200	HISTOP:	MOVE A,PACPTR-Q(A)
00300		SETZM HISTOV	;CLEAR HISTOGRAM
00400		MOVE B,[XWD HISTOV,HISTOV+1]
00500		BLT B,HISTOV+107
00600		HRLI A,-217	;LOOP COUNTER
00700		SETZ E,		;COLOR POINTER
00800	
00900		MOVE C,PAC(A)
01000		MOVEI F,44
01100	
01200	HISTP2:	JFFO C,.+6
01300			ADD E,F
01400			AOBJN A,.-4
01500			SETZ A,		;EXIT
01600			MOVE F,TEMP
01700			POPJ P,
01800	
01900		LSH C,@D
02000		ADD E,D
02100		SUB F,D
02200		MOVE B,COLORS(E)	;GET BYTES 0,1,2,3
02300		LDB D,[POINT 4,B,8]	;INCREMENT
02400		AOS HISTOV(B)		;COLOR 0
02500		LDB D,[POINT 4,B,17]	
02600		AOS HISTOV+20(D)	;COLOR 1
02700		LDB D,[POINT 4,B,26]
02800		AOS HISTOV+40(D)	;COLOR 2
02900		ANDI B,17
03000		AOS HISTOV+60(D)	;COLOR 3
03100	
03200		LSH C,1
03300		JRST HISTP2
     

00100	;SET PAC FOR COLORS BETWEEN MIN AND MAX
00200	;(SIEVE PAC COLOR MIN MAX)
00300	SIEVE:	INUM A,
00400		INUM B,
00500		ANDI A,17
00600		ANDI B,3
00700		MOVE E,CWCOLR(B)	;CHANGE CAMERA WINDOW OF PAC.
00800		MOVEM E,CWPAC(A)
00900		MOVE F,PACPAC+1(A)
01000		MOVE E,PACPAC(A)
01100		HRRM E,SVEPAC
01200		INUM C,
01300		INUM D,
01400		HRRM C,SVEMIN
01500		HRRM D,SVEMAX
01600		MOVE A,CBP17(B)
01700		SETZM 0(E)		;CLEAR PAC.
01800		SOS F
01850		MOVEM F,SVEEND#
01900		HRLS E
02000		AOS E
02100		BLT E,@F
02200		JSR ACPUT
02300		MOVE [XWD .+3,2]
02400		BLT 17
02500		JRST 4
02600					;0	BYTE
02700					;1 A	CBP(17)
02800		1			;2 B	BIT-MASK
02900		0			;3 C	PAC-WORD
03000		ROT B,-1		;4
03100		LDB A			;5
03200	SVEMIN:	CAIGE			;6
03300		JRST 12			;7
03400	SVEMAX:	CAIGE			;10
03500		TDO C,B			;11
03600		AOBJP 17,[MOVEM C,@SVEEND↔JSR ACGET↔SETZ 1,↔POPJ P,]
03700		CAIE B,1		;13
03800		JRST 4			;14
03900	SVEPAC:	EXCH C,PAC		;15
04000		AOJA 15,4		;16
04100		XWD -110*110,0		;17	CBP-INDEX.
04200	
04300	CBP17:	POINT 9,COLORS(17),8
04400		POINT 9,COLORS(17),17
04500		POINT 9,COLORS(17),26
04600		POINT 9,COLORS(17),35
     

00100	;(PACK PAC COLOR N)
00200	;PACK PICTURE ACCUMULATOR INTO COLOR USING M
00300	PACK:	MOVE D,PACPTR-Q(A)
00400		MOVE B,CBPTR-Q(B)
00500		INUM C,
00600		MOVEI F,217
00700		MOVEI E,43
00750		AOS D
00800		MOVE A,PAC(D)
00900		TLNE A,400000
01000		DPB C,B
01100		LSH A,1
01200		AOS B
01300		SOJGE E,.-4
01400		SOJGE F,.-10
01500		SETZ A,
01600		POPJ P,
     

00100	;(BLOT PAC)  INK-BLOT  - KING'S MOVE.
00200	DEFINE BLTMAC   (KEY){
00300	IFGE KEY,<	IORM E,PAC-2(A)   >	
00400	IFGE KEY,<	IORM F,PAC-1(A)   >
00500	           	IORM E,PAC  (A)
00600	          	IORM F,PAC+1(A)
00700	IFLE KEY,<	IORM E,PAC+2(A)   >
00800	IFLE KEY,<	IORM F,PAC+3(A)   >
00900	}
01100	BLOT:	MOVE A,PACPTR-Q(A)
01200		HRLI A,20*220
01300		SETZM PAC20	;CLEAR PAC 20
01400		MOVE  B,[XWD PAC20,PAC20+1]
01500		BLT   B,PAC20+217
01600		HRRZ B,A
01700		HRLI B,PAC20
01800		ADDI B,PAC	;RETURN BLIT'S AC.
01900		HRRZ C,B
02000		ADDI C,217	;RETURN BLIT'S ADDR.
02100	
02200		;FIRST LINE.
02300		MOVE E,PAC  (A)	;PICK UP OUT OF ARG PAC.
02400		MOVE F,PAC+1(A)
02500		MOVSS A
02600		BLTMAC -1
02700		MOVE G,E  ↔  MOVE H,F
02800		LSHC E,1
02900		BLTMAC -1
03000		MOVE E,G  ↔  MOVE F,H
03100		LSHC E,-1
03200		BLTMAC -1
03300		MOVSS A
03400	
03500		MOVEI D,106	;FORGET FIRST AND LAST LINES.
03600	BLOT1:	ADD A,[XWD 2,2]
03700		MOVE E,PAC  (A)	;PICK UP OUT OF ARG PAC.
03800		MOVE F,PAC+1(A)
03900		MOVSS A
04000		BLTMAC 0
04100		MOVE G,E  ↔  MOVE H,F
04200		LSHC E,1
04300		BLTMAC 0
04400		MOVE E,G  ↔  MOVE F,H
04500		LSHC E,-1
04600		BLTMAC 0
04700		MOVSS A
04800		SOJG D,BLOT1
04900	
05000		ADD A,[XWD 2,2]	;LAST LINE.
05100		MOVE E,PAC  (A)	;PICK UP OUT OF ARG PAC.
05200		MOVE F,PAC+1(A)
05300		MOVSS A
05400		BLTMAC 1
05500		MOVE G,E  ↔  MOVE H,F
05600		LSHC E,1
05700		BLTMAC 1
05800		MOVE E,G  ↔  MOVE F,H
05900		LSHC E,-1
06000		BLTMAC 1
06100		MOVSS A
06200	
06300		BLT B,@C
06400		SETZ 1,
06500		POPJ P,
     

00100	;(XMINW PAC)
00200	;XMINIMUM AND WIDTH
00300	XMINW:	MOVE A,PACPTR-Q(A)
00400		MOVEI C,107	;LOOP COUNTER
00500		SETZB B,D
00600		IOR B,PAC(A)
00700		IOR D,PAC+1(A)
00800		ADDI A,2
00900		SOJGE C,.-3
01000
01100		JFFO B,.+6
01200		JFFO D,.+3
01300		MOVEI A,Q
01400		POPJ P,		;NOTHING RETURN
01500		ADDI E,44
01600		MOVE C,E
01700
01800		SETZ E,			;BIT COUNTER
01900		MOVN A,B
02000		TDZE B,A
02100		AOJA E,.-2
02200		MOVN A,D
02300		TDZE D,A
02400		AOJA E,.-2
02500		MOVE A,C
02600		ASH A,7
02700		IOR A,E
02800		ADDI A,Q ↔ POPJ P,
02900
03000	;(AREA PAC)
03100	;RETURNS A COUNT OF TH NUMBER OF POINTS IN A PICTURE
03200	AREA:	MOVE A,PACPTR-Q(A)
03300		MOVEI B,217		;LOOP COUNTER
03400		SETZ C,		;BIT COUNTER
03500		MOVE D,PAC(A)
03600		MOVN E,D		;MASK
03700		TDZE D,E
03800		AOJA C,.-2
03900		AOS A
04000		SOJGE B,.-5
04100		MOVE A,C
04200		ADDI A,Q ↔ POPJ P,
     

00100	;(YMIN PAC)
00200	;RETURNS LEAST Y-COORDINATE OF A POINT
00300	YMAX:	MOVE C,PACPTR-Q(A)
00350		AOS A
00400		MOVE A,PACPTR-Q(A)
00500		MOVEI B,217
00600		SOS A
00700		SKIPN PAC(A)
00800		SOJGE B,.-2
00850		SUB A,C
00900		ASH A,-1
01000		ADDI A,Q ↔ POPJ P,
01100
01200	;(YMAX PAC)
01300	;RETRUN GREATEST Y-COORDINATE
01400	YMIN:	MOVE A,PACPTR-Q(A)
01450		MOVE C,A
01500		MOVEI B,217
01600		SKIPE PAC(A)
01700		JRST .+3
01800		AOS A
01900		SOJGE B,.-3
01950		SUB A,C
02000		ASH A,-1
02100		ADDI A,Q ↔ POPJ P,
     

00100	;(PAYROT PAC DY)  PAC - Y - ROTATE.
00200	PAYROT:	INUM B,
00300		MOVM C,B
00400		CAIL C,110
00500		JRST [IDIVI B,110↔EXCH B,C↔JRST .+1]	;MODULO 110 ROTATION
00600		HRLZ C,PACPAC-Q(A)	;HRLZ TWO COPIES OF PAC INTO TEMPORARIES.
00700		HRRI C,PAC23
00800		BLT C,PAC24-1
00900		HRLZ C,PACPAC-Q(A)
01000		HRRI C,PAC24
01100		BLT C,PAC25-1
01200		ASH B,1		;2*DY
01300		HRLZ C,PACPAC-Q(A)
01400		HRRI C,PAC24
01500		SKIPGE B
01600		HRRI C,PAC23
01700		SUB C,B
01800		MOVSS C
01900		AOS A
02000		MOVE A,PACPAC-Q(A)
02100		SOS A		;LAST WORD IN PAC.
02200		BLT C,@A
02300		SETZ 1,
02400		POPJ P,
02500	;(PAYSH PAC DY)  PAC - Y - SHIFT.
02600	PAYSH:	MOVE D,A
02700		MOVE A,PACPAC-Q(A)
02800		INUM B,
02900		HLR C,CWPAC-Q(D) ↔ ADD C,B ↔ HRLM C,CWPAC-Q(D)
03000		MOVM C,B
03100		CAIL C,110
03200		JRST PZIP+1	;SHIFT LARGER THAN PAC HEIGHT.
03300		JUMPGE B,PAYSH2
03400	;NEGATIVE DY SHIFT UP-SCREEN WHICH IS DOWN-CORE.
03500		HRLS A		;PAC,,PAC
03600		ASH C,1		; 2*DY
03700		HRLZS C		; 2*DY,,0
03800		ADD A,C		; PAC+2*DY,,PAC   or   FROM,,TO-FIRST
03900		AOS D
04000		MOVE D,PACPAC-Q(D)
04100		MOVE E,D	;NEXT PAC
04200		MOVSS C		; 0,,2*DY
04300		SUB D,C		; 2*(110-DY)
04400		SOS D		; 2*(110-DY) - 1  or  0,,TO-LAST
04500		BLT A,@D	;MOVE BITS DOWN CORE.
04600		AOS D
04700		SETZM 0(D)
04800		HRLS D
04900		AOS D
05000		SOS E		;LAST WORD OF THIS PAC
05100		BLT D,@E	;CLEAR UP-CORE BITS WHICH IS THE BOTTOM OF THE PAC.
05200		SETZ 1,↔	POPJ P,
     

00100	;POSITIVE DY
00200	PAYSH2:	JUMPE B,.-2	;NO SHIFTING.
00300		HRL C,A
00400		HRRI C,PAC23
00450		MOVE E,C
00500		BLT E,PAC24-1	;MOVE PAC INTO PAC23
00600		MOVSS C
00700		ASH B,1
00900		ADD C,B		;FROM PAC23,,TO PAC+2*DY
01000		AOS  D
01100		MOVE D,PACPAC-Q(D)
01200		SOS D	;LAST WORD OF THIS PAC
01300		MOVE E,C
01400		BLT E,@D	;MOVE BITS UP-CORE IN THE PAC.
01500		HRRZS C
01600		SOS C
01700		SETZM @A
01800		HRLS A
01900		AOS A
02000		BLT A,@C	;CLEAR TOP OF PAC
02100		SETZ 1,
02200		POPJ P,
02300	;(PAXROT PAC DX)  PAC - X -ROTATE.
02400	;(PAXSH  PAC DX)  PAC - X - SHIFT.
02500	PAXROT:	SKIPA C,[<ROTC>]
02600	PAXSH:	MOVE  C,[<LSHC>]
02700		MOVEM C,PAX2
02800		MOVEM AC0	;SAVE AC 0
02900		INUM B,
02950		LDB C,[POINT 9,CWPAC-Q(A),8]
02975		ADD C,B
02987		DPB C,[POINT 9,CWPAC-Q(A),8]
03000		HRRM B,PAX2	;DX COUNT.
03100		MOVE 2,PACPTR-Q(A)	;PAC POINTER.
03200		MOVEI 3,107		;LOOP COUNTER.
03300		MOVE [XWD PAX3,4]
03400		BLT 13
03500		JRST 4
03600	PAX3:	MOVE 0,PAC  (2)		;4
03700		MOVE 1,PAC+1(2)		;5
03800	PAX2:	ROTC 0,0		;6
03900		MOVEM 0,PAC  (2)	;7
04000		MOVEM 1,PAC+1(2)	;10
04100		ADDI 2,2		;11
04200		SOJGE 3,4		;12
04300		JRST PAX4		;13
04400	PAX4:	MOVE AC0
04500		SETZ 1,	
04600		POPJ P,
04700	;(PRISS PAC DXY)
04800	PRISS:	MOVE D,A
04900		MOVE E,B
05000		PUSHJ P,PAYROT		;DOWN
05100		MOVE A,D
05200		INUM E,
05300		MOVN B,E
05400		ADDI B,Q		;AND TO THE RIGHT.
05500		PUSHJ P,PAXROT
05600		POPJ P,
05700	;(PROSS PAC DXY)
05800	PROSS:	MOVE D,A
05900		INUM B,
06000		MOVNS B
06100		ADDI B,Q
06200		MOVE E,B
06300		PUSHJ P,PAYROT		;UP
06400		MOVE A,D
06500		MOVE B,E
06600		PUSHJ P,PAXROT		;AND TO THE RIGHT.
06700		POPJ P,
     

00100	;(SUMY PAC)(SUMSQY)
00200	SUMY:	MOVEM TEMP
00300		MOVEM 6,TEM2#
00400		MOVE A,PACPTR-Q(A)
00500		MOVEI B,107	;LOOP COUNTER
00600		SETZB 6,7
00700		
00800	SUMY1:	SETZ C,
00900		MOVE D,PAC(A)
01000		MOVN E,D
01100		TDZE D,E
01200		AOJA C,.-2
01300		MOVE D,PAC+1(A)
01400		MOVN E,D
01500		TDZE D,E
01600		AOJA C,.-2
01700		IMUL C,B
01800		ADD C
01900		IMUL C,B
02000		ADD 6,C
02100		ADDI A,2
02200		SOJGE B,SUMY1
02300		MOVE A,7
02400		EXCH 6,TEM2
02500		JCALL 1,FIX1A
02600	SUMSQY:	MOVE 1,TEM2
02700		JCALL 1,FIX1A
     

00100	XHIST:
00200	BLOCK 110
00300	;(SUMX PAC)(SUMSQX)
00400	SUMX:	MOVE TEMP
00500		INUM A,
00600		ASH A,7
00700		SETZM XHIST 
00800		MOVE B,[XWD XHIST,XHIST+1]
00900		BLT B,XHIST+107	;CLEAR X HISTOGRAM
01000		MOVEI B,77	;LOOP COUNTER
01100	SUMX1:	SETZ E,		;X HISTOGRAM POINTER
01200		MOVE C,PAC(A)
01300		MOVE 0,PAC+1(A)	;PICKUP HORIZONTAL LINE
01400	SUMX2:	JFFO C,.+2
01500		JRST SUMX3
01600		ADD E,D
01700		AOJ  E,
01800		AOS XHIST(E)
01900		EXCH D,0
02000		LSHC C,1
02100		LSHC C,@0
02200		EXCH D,0
02300		JRST SUMX2
02400	SUMX3:	JUMPE SUMX4
02500		ADDI E,44
02600		EXCH C,0
02700		JRST SUMX2
02800	SUMX4:	ADDI A,2
02900		SOJGE B,SUMX1
03000		MOVEI A,107	;XHIST POINTER
03100		SETZB B,C
03200
03300		MOVE D,XHIST(A)	;NUMBER OF POINTS AT
03400		JUMPE D,.+5
03500
03600		IMUL D,A	;VALUE X
03700		ADD B,D
03800		IMUL D,A	;SQUARED
03900		ADD C,D
04000
04100		SOJGE A,.-6
04200		MOVEM C,TEMP
04300		MOVE A,B
04400		JCALL 1,FIX1A
04500
04600	SUMSQX:	MOVE A,TEMP
04700		JCALL 1,FIX1A
     

00100	;GRADIENT
00200	;RETURNS (DX↑2 + DY↑2)*2↑-4  IN COLOR 1
00300
00400	GRAD:	MOVEI A,220*220-1
00500		MOVE B,COLORS(A)
00600		ANDI B,777
00700
00800		MOVE D,COLORS+1(A)
00900		ANDI D,777
01000		SUB D,B		;DELTA X
01100
01200		MOVE C,COLORS+110(A)
01300		ANDI C,777
01400		SUB C,B		;DELTA Y
01500
01600		IMUL C,C
01700		IMUL D,D	;SQUARED
01800
01900		ADD C,D
02000		ASH C,-4
02100
02200		ANDI C,777
02300		ROT C,9
02400
02500		IOR C,B
02600		HRRM C,COLORS(A)
02700
02800		SOJGE A,GRAD+1
02900		SETZ A,
03000		POPJ P,
03100
     

00100	;COLOR ARITHMETIC OPERATION SUBGROUP.
00200	CBPTRB:	POINT 9,COLORS-1(B),8
00300		POINT 9,COLORS-1(B),17
00400		POINT 9,COLORS-1(B),26
00500		POINT 9,COLORS-1(B),35
00600	ADDC:	MOVEI C,(<ADD>)↔JRST IDIVC+1	;(ADDC C1 C2)
00700	SUBC:	MOVEI C,(<SUB>)↔JRST IDIVC+1	;(SUBC C1 C2)
00800	IMULC:	MOVEI C,(<IMUL>)↔JRST IDIVC+1	;(IMULC C1 C2)
00900	IDIVC:	MOVEI C,(<IDIV>)		;(IDIVC C1 C2)
01000		HRLM C,COLREX		;COLOR EXECUTION.
01100		JSR ACPUT
01200		MOVE C,CBPTRB-Q(A)	;FIRST BYTE POINTER
01300		MOVE D,CBPTRB-Q(B)	;SECOND BYTE POINTER.
01400		MOVEI B,110*110
01500		MOVE [XWD COLROP,5]
01600		BLT 17
01700		JRST 5
01800					;0 TEMPORARY
01900					;1 A   TEMPORARY
02000					;2 B COUNTER & INDEX
02100					;3 C FIRST BYTE POINTER
02200					;4 D SECOND BYTE POINTER
02300	COLROP:	LDB 0,C			;5 FETCH FIRST BYTE.
02400		TRNE 0,400		;6 EXTEND SIGN.
02500		IOR 0,17		;7
02600		LDB 1,D			;10 FETCH SECOND BYTE.
02700		TRNE 1,400		;11 EXTEND SIGN.
02800		IOR 1,17		;12
02900	COLREX:	ADD 1			;13 EXECUTION
03000		DPB 0,C			;14 DEPOSIT
03100		SOJG B,5		;15 LOOP
03200		JRST .+2		;16 EXIT
03300		-1000		;17
03400		JSR ACGET
03500		SETZ 1,
03600		POPJ P,
03700	
03800	;DOUBLE COLOR HALFWORD OP.
03900	DADDC:	SKIPA 6,[<ADD A,B>]		;(DADDC C1 C2)
04000	DSUBC:	MOVE  6,[<SUB A,B>]		;(DSUBC C1 C2)
04100		INUM A,
04200		INUM B,
04300		MOVE 4,[<HLRE A,COLORS-1(C)>]
04400		SKIPE A
04500		MOVE 4,[<HRRE A,COLORS-1(C)>]
04600		MOVE 5,[<HLRE B,COLORS-1(C)>]
04700		SKIPE B
04800		MOVE 5,[<HRRE B,COLORS-1(C)>]
04900		MOVE 7,[<HRLM A,COLORS-1(C)>]
05000		SKIPE A
05100		MOVE 7,[<HRRM A,COLORS-1(C)>]
05200		MOVEI C,110*110
05300		MOVE 10,[<SOJG C,4>]
05400		HRLZI 11,(<SETZ 1,>)
05500		HRLZI 12,(<POPJ P,>)
05600		JRST 4
05700	;ACCUMULATORS:
05800	;A
05900	;B
06000	;C INDEX & LOOP COUNTER
06100	;4	HXRE A,COLORS-1(C)
06200	;5	HYRE B,COLORS-1(C)
06300	;6	ADD or SUB A,B
06400	;7	HRXM A,COLORS-1(C)
06500	;10	SOJG C,4
06600	;11	SETZ 1,
06700	;12	POPJ P,
06800	
06900	
07000	;(MULC C1 C2)
07100	MULC:	JSR ACPUT
07200		MOVE A,CBPTRB-Q(A)
07300		MOVEM A,AC1
07400		MOVE C,CBPTRB-Q(B)
07500		MOVEI B,110*110
07600		MOVE [XWD .+3,4]
07700		BLT 17
07800		JRST 4
07900		LDB 0,AC1		;4
08000		TRNE 0,400		;5
08100		IOR 0,[-1000]	;6
08200		LDB 1,C			;7
08300		TRNE 0,400		;10
08400		IOR 1,[-1000]	;11
08500		IMUL 1			;12
08600		DPB C			;13
08700		ASH -11			;14
08800		DPB AC1			;15
08900		SOJG B,4		;16
09000		JRST .+1		;17
09100		JSR ACGET
09200		SETZ 1,
09300		POPJ P,
09400	
09500	
09600	;(DIVC C1 C2)
09700	DIVC:	JSR ACPUT
09800		MOVE C,CBPTRB-Q(A)
09900		MOVE D,CBPTRB-Q(B)
10000		MOVEI B,110*110
10100		MOVE [XWD .+3,5]
10200		BLT 17
10300		JRST 5
10400		LDB 0,C			;5
10500		TRNE 0,400		;6
10600		IOR 0,[-1000]	;7
10700		LDB 1,D			;10
10800		TRNE 1,400		;11
10900		IOR 1,[-1000]	;12
11000		IDIV 1			;13
11100		DPB 0,C			;14
11200		DPB 1,D			;15
11300		SOJG B,5		;16
11400		JRST .+1		;17
11500		JSR ACGET
11600		SETZ 1,
11700		POPJ P,
11800	
11900	
12000	;MINOR ARITHMETIC SUBGROUP.
12100	
12200	;COLOR ARITHMETIC SHIFT LEFT N.
12300	;(CASH COLOR N)
12400	CASH:	MOVE A,CBPTRB-Q(A)
12500		INUM B,
12600		MOVE C,[XWD .+5,4]
12700		BLT C,13
12800		HRR 7,B
12900		MOVEI B,110*110
13000		JRST 4
13100					;A POINTER
13200					;B COUNTER
13300					;C BYTE
13400		LDB C,A			;4
13500		TRNE C,400		;5
13600		IOR C,13		;6
13700		ASH C,0			;7
13800		DPB C,A			;10
13900		SOJG B,4		;11
14000		JRST .+2		;12
14100		-1000		;13
14300		SETZ 1,
14400		POPJ P,
14500	
14600	
14700	
14800	;(CABS COLOR)
14900	CABMSK:	1B0↔1B9↔1B18↔1B27
15000	;COLOR ABSOLUTE VALUE.
15100	CABS:	MOVE C,CABMSK-Q(A)
15200		MOVEI B,110*110
15300		MOVE A,CBPTRB-Q(A)
15400		JSR ACPUT
15500		MOVE [XWD .+3,4]
15600		BLT 15
15700		JRST  4
15800					;0 TEMPORARY
15900					;1 A POINTER
16000					;2 B COUNTER
16100					;3 C MASK
16200		TDNE C,COLORS-1(B)	;4
16300		JRST 10			;5
16400		SOJG B,4		;6
16500		JRST .+7		;7
16600		LDB A			;10
16700		IOR 15			;11
16800		MOVMS			;12
16900		DPB A			;13
17000		JRST 6			;14
17100		-1000		;15
17200		JSR ACGET
17300		SETZ 1,
17400		POPJ P,
17500	
17600	
17700	
17800	
17900	;(ZIPALL) CLEAR ALL COLORS.
18000	ZIPALL:	SETZM COLORS
18100		MOVE A,[XWD COLORS,COLORS+1]
18200		BLT A,COLORS+110*110-1
18300		SETZ A,
18400		POPJ P,
18500	
18600	
18700	;(CZIP COLOR)  CLEAR COLOR BYTE.
18800	CZIP:	MOVE C,CBPTRB-Q(A)
18900		SETZ A,
19000		MOVEI B,110*110
19100		MOVE D,[<DPB A,C>]
19200		MOVE E,[<SOJG B,D>]
19300		HRLZI F,(<POPJ P,>)
19400		JRST D
19500	
19600	
19700	
19800	;(ZIPNEG COLOR)  CLEAR ALL NEGATIVE INTENSITIES IN COLOR.
19900	ZIPNEG:	MOVE D,CABMSK-Q(A)
20000		MOVE C,CBPTRB-Q(A)
20100		SETZ A,
20200		MOVEI B,110*110
20300		MOVE E,[<TDNE D,COLORS-1(B)>]
20400		MOVE F,[<DPB A,C>]
20500		MOVE G,[<SOJG B,E>]
20600		HRLZI H,(<POPJ P,>)
20700		JRST E
20800	
20900	
21000	
21100	;(CROUND COLOR N) V:=(V + 2**(N-1)) * 2**(-N)
21200	CROUND:	MOVE D,CBPTRB-Q(A)
21300		INUM B,
21400		JSR ACPUT
21500		MOVE [XWD ROUND1,5]
21600		BLT 17
21700		MOVN A,B
21800		HRR 11,A
21900		SOS B
22000		MOVEI C,1
22100		ASH C,@B
22200		MOVEI B,110*110
22300		JRST 5
22400					;0    
22500					;1  A TEMPORARY
22600					;2  B INDEX
22700					;3  C HALF
22800					;4  D POINTER
22900	ROUND1:	LDB A,D			;5
23000		TRNE A,400		;6
23100		JRST 15			;7
23200		ADD A,C			;10
23300		ASH A,0			;11
23400		DPB A,D			;12
23500		SOJG B,5		;13
23600		JRST .+4		;14
23700		IOR A,[-1000]	;15
23800		SUB A,C			;16
23900		JRST 11			;17
24000	JSR ACGET↔SETZ 1,↔POPJ P,
24100	
24200	
24300	
24400	;(CASHAL N)  SHIFT ALL COLORS.
24500	CASHAL:	INUM A,
24600		MOVE B,[XWD .+6,D]
24700		BLT B,10
24800		HRR E,A
24900		MOVEI C,110*110
24950		SETZ 1,
25000		JRST D
25100		MOVE B,COLORS-1(C)	;D
25200		ASH B,			;E
25300		MOVEM B,COLORS-1(C)	;6
25400		SOJG C,D		;7
25500		POPJ P,			;10
25600	
25700	;SCALAR INTEGER COLOR ARITHMETIC SUBGROUP.
25800	SICMUL:	MOVEI C,(<IMUL>) ↔JRST SICADD+1			;(SICMUL COLOR K)
25900	SICDIV:	MOVEI C,(<IDIV>) ↔JRST SICADD+1			;(SICDIV COLOR K)
26000	SICSUB:	MOVEI C,(<SUB>) ↔JRST SICADD+1			;(SICSUB COLOR K)
26100	SICADD:	MOVEI C,(<ADD>)					;(SICADD COLOR K)
26200		HRLM C,SICEX
26300		MOVEM AC0
26400		MOVE D,CBPTRB-Q(A)
26500		INUM B,
26600		MOVE C,B		;SAFE KEEPING K
26700		MOVEI B,110*110
26800		MOVE [XWD .+3,5]
26900		BLT 13
27000		JRST 5
27100		LDB D			;5
27200		TRNE 400		;6
27300		IOR [-1000]		;7
27400	SICEX:	ADD C			;10 EXECUTE
27450		DPB D			;11
27500		SOJG B,5		;12
27600		JRST .+1		;13
27800		MOVE AC0
27900		SETZ 1,
28000		POPJ P,
     

00100	;TV CAMERA SERVO INITIALIZAION
00200	TSINIT:	MOVEI 1,11
00300		MOVE 1,STATUS
00400		SPCWAR 0,636367
00500		SPCWAR 1,TSERVO
00600		SETZ A,
00700		POPJ P,
00800
00900	;READ SPACE WAR SWITCHES
01000	SWS:	CALLI 1,400000
01100		ANDI 1,30377
01200				;REVOLUTION-20000 QUARTER-10000
01300		JCALL 1,FIX1A
01400
01500	;STOP SPACEWAR JOB
01600	STOPWAR:	SPCWAR 0,636367
01700			SETZ A,
01800			POPJ P,
01900
02000	;ADVANCE LENS TURRET
02100	LENS:	MOVEI 1,14
02200		MOVEM 1,STATUS
02300		MOVE 1,STATUS
02400		TRNE 1,20
02500		HALT		;HUNG
02600		TRNN 1,1
02700		JRST .-4
02800		SETZ 1,
02900		POPJ P,
03000
03100	;CLEAR COLORS
03200	ZIP:	SETZM COLORS
03300		MOVE A,[XWD COLORS,COLORS+1]
03400		BLT A,COLORS+110*110-1
03500		SETZ A,
03600		POPJ P,
     

00100	FOCUS:	INUM A,
00200		MOVEM 1,L1
00300		SETZB 1,STATUS
00400		POPJ P,
00500	PAN:	INUM A,
00600		MOVEM 1,L3
00700		SETZB 1,STATUS
00800		POPJ P,
00900	TILT:	INUM A,
01000		MOVEM 1,L2
01100		SETZB 1,STATUS
01200		POPJ P,
01300	FFF:	MOVE A,P1
01400		ADDI A,Q ↔ POPJ P,
01500	PPP:	MOVE A,P3
01600		ADDI A,Q ↔ POPJ P,
01700	TTT:	MOVE A,P2
01800		ADDI A,Q ↔ POPJ P,
01900
02000
     

00100	;(JOINT J X)
00200	;MOVE JOINT J X INCREMENTS OR DECREMENTS
00300	JOINT:	MOVEM B,C
00400		INUM A,
00500		EXCH A,C
00600		INUM A,
00700		ANDI C,7
00800		SOS C
00900		ADDM A,JOY(C)
01000		SETZ A,
01100		POPJ P,
01200	JOY:	0
01300		BLOCK 10
01400
01500	;(ARM)  START ARM SPACE WAR JOB
01600	ARM:	SPCWAR 0,636367
01700		SPCWAR 1,DAC3
01800		SETZ A,
01900		POPJ P,
02000
02100	;(DAC N Z)  N=1 TO 7
02200	;SET D TO A CONVERTER
02300	DAC:	MOVEM B,C
02400		INUM A,
02500		EXCH A,C
02600		INUM A,
02700		ASH A,12
02800		ANDI C,7
02900		SOS C
03000		IOR A,C
03100		HRRM A,DAC3(C)
03200		SETZ A,
03300		POPJ P,
03400
     

00100	;ARM SPACE WAR JOB
00200	DAC3:	CONO 600,0	;SET UP D TO A
00300		CONO 600,1
00400		CONO 600,2
00500		CONO 600,3
00600		CONO 600,4
00700		CONO 600,5
00800		CONO 600,6
00900
01000		MOVEI A,6	;COUNT
01100		MOVEI B,20	;BIT
01200		SETZ C,	;DATAO WORD TO BE
01300
01400	DAC4:	SKIPN D,JOY(A)
01500		JRST DAC6
01600		IOR C,B	;NON-ZERO JOINT COUNT
01700		ROT B,1
01800		SKIPG D
01900		JRST DAC5
02000		ROT B,1	;POSITIVE
02100		SOS JOY(A)
02200		JRST DAC6A
02300
02400	DAC5:	IOR C,B	;NEGATIVE
02500		ROT B,1
02600		AOS JOY(A)
02700		JRST DAC6A
02800
02900	DAC6:	ROT B,2	;ZERO JOINT COUNT
03000	DAC6A:	SOJGE A,DAC4
03100		MOVEM C,DAC8
03200		DATAO 420,DAC8
03300		HALT
03400	DAC8:	0
03500
     

00100	
00200	;PUT DOWN  ACCUMULATORS  0,14,15,16,17.
00300	ACPUT:	0
00400		MOVEM AC0
00500		MOVE [XWD 14,AC14]
00600		BLT AC0+17
00700		MOVE AC0
00800		JRST @ACPUT
00900	
01000	;RESTORE  ACCUMULATORS   0,14,15,16,17.
01100	ACGET:	0
01200		MOVE [XWD AC14,14]
01300		BLT 17
01400		MOVE AC0
01500		JRST @ACGET
01600	
01700	AC0:	0
01800	AC1:	0
01900	AC2:	0
02000	AC3:	0
02100	AC4:	0
02200	AC5:	0
02300	AC6:	0
02400	AC7:	0
02500	AC10:	0
02600	AC11:	0
02700	AC12:	0
02800	AC13:	0
02900	AC14:	0
03000	AC15:	0
03100	AC16:	0
03200	AC17:	0
03300	
     

00100		DH←←0
00200		DV←←1
00300		VI←←2
00400		HI←←3
00500		MM←←4
00600	;(LSD PAC) LINE SEGMENT DETECTOR.
00700	LSD:	MOVE A,PACPTR-Q(A)
00800		MOVEM A,LSDPTR#
00900	
01000	;CLEAR COLORS FOR TALLY ARRAY.
01100		SETZM COLORS
01200		MOVE B,[XWD COLORS,COLORS+1]
01300		BLT  B,COLORS+110*110-1
01400	
01500	;PLACE INNERMOST LOOP OF LSD IN ACCUMULATORS.
01600		JSR ACPUT
01700		MOVE B,[XWD[
01800					;0  DH  OR PAC+1
01900					;1  DV  OR PAC
02000					;2  VI  OR X    OR JFFO COUNT
02100					;3  HI  OR Y
02200					;4  MM  COUNTER FOR SLOPE LOOP.
02300		1B17			;5 LEFT HALF ONE
02400		AOS    COLORS(VI)	;6 HORIZONTAL TALLY.
02500		ADDM 5,COLORS(HI)	;7 VERTICAL TALLY.
02600		MOVSS HI		;10
02700		MOVSS VI		;11
02800		ADD HI,DH		;12
02900		ADD VI,DV		;13
03000		MOVSS HI		;14
03100		MOVSS VI		;15
03200		SOJG MM,6		;16
03300		JRST LSD2		;17
03400				],5]
03500		BLT B,17
03600		HRREI 3,-1		;INITIALIZE Y.
03700	
03800	;GET NEXT ROW OF PAC.
03900	LSD1:	SETZB 2,LSDX		;CLEAR X.
04000		AOS 3			;INCREMENT Y.
04100		MOVEM 3,LSDY
04200		MOVE 4,3
04300		LSH 4,1
04400		ADD 4,LSDPTR		;PAC POINTER.
04500		MOVE 0,PAC+1(4)
04600		MOVE 1,PAC+0(4)
04700		JRST LSD2B
     

00100	;INITIALIZE INNER LOOP AND EXECUTE.
00200	LSD3:	EXCH 1		;SHIFT PAC ROW AND SAVE.
00300		LSHC @2	↔ LSHC 1
00400		MOVEM LSDPAC+1
00500		MOVEM 1,LSDPAC
00600		ADDB 2,LSDX	;INCREMENT X.
00700	
00800	;HALFWORD RECIPRICOLS:
00900	;	1,,10    =44* (3 * 4573) FOR ALMOST 1/44
01000	;	0,,777777= 3*252525 FOR ALMOST 1/3
01100	;AC0  DH = 110 - (X/44)			FREE.
01200	;AC1  DV = 110 - (Y/44)			FREE.
01300	;AC2  VI = ((X+Y) +107)/3		INITIALLY X.
01400	;AC3  HI = ((Y+X) +107)/3		INITIALLY Y.
01500	;AC4  MM = 110				FREE
01600		MOVN 0,2
01700		MOVN 1,3
01900		ADDB 2,3
02000		ADDI 2,107
02100		ADDI 3,107
02200		IMULI 2,252525
02300		IMULI 3,252525
02400		IMULI 0,4573
02500		IMULI 1,4573
02600		ADD 0,[XWD 110,0]
02700		ADD 1,[XWD 110,0]
02800		MOVEI MM,110
02850		MOVSS HI↔MOVSS VI
02900		JRST 6		;EXECUTE ACCUMULATORS.
03000	
03100	;JFFO BIT FINDER.
03200	LSD2:	MOVE 4,[XWD [LSDPAC:	0	↔	0
03300			     LSDX:	0
03400			     LSDY:	0	],0]
03500		BLT 4,3
03600	LSD2B:	JFFO 1,LSD3	;FOUND A BIT.
03700		;NO BIT IN FIRST WORD OF ROW.
03800		SKIPE 1,0	;CHECK FOR ANY BITS IN 2ND WORD OF ROW.
03900		JRST [SETZ↔MOVEI 2,44↔ADDM 2,LSDX↔JRST LSD2B]
04000	
04100	;NEXT ROW  ?
04200		CAIE 3,107
04300		JRST LSD1
04400		JSR ACGET	;ALL DONE.
04500		SETZ 1,
04600		POPJ P,
     

00100	;(LOCMAX PACV PACH THRESHOLD)
00200	LOCMAX:	MOVE A,PACPTR-Q(A)
00300		MOVE B,PACPTR-Q(B)
00400		ADD A,[POINT 1,PAC]
00500		ADD B,[POINT 1,PAC]
00600		INUM C,
00700	LOCMX0:	MOVE D,[XWD -110*110,COLORS]
00800		SETO E,
00900	
01400	DEFINE LMAXA (FETCH,BITPTR,LABEL) {
01500		FETCH F,0(D)
01600		CAMGE F,C
01700		JRST LABEL
01800		FETCH G, -111(D)↔CAMGE F,G↔JRST LABEL
01900		FETCH G, -110(D)↔CAMGE F,G↔JRST LABEL
02000		FETCH G, -107(D)↔CAMGE F,G↔JRST LABEL
02100		FETCH G,   -1(D)↔CAMGE F,G↔JRST LABEL
02200		FETCH G,    1(D)↔CAMGE F,G↔JRST LABEL
02300		FETCH G,  107(D)↔CAMGE F,G↔JRST LABEL
02400		FETCH G,  110(D)↔CAMGE F,G↔JRST LABEL
02500		FETCH G,  111(D)↔CAMGE F,G↔JRST LABEL
02600		IDPB E,BITPTR
02700		SKIPA
02800	LABEL:	IBP BITPTR  }
02900	
03000		LMAXA HLRZ,A,LOCMX1
03100		LMAXA HRRZ,B,LOCMX2
03200		AOBJN D,LOCMX0+1
03300		SETZ 1,
03400		POPJ P,
03500	
03600	;(PDOT PAC X Y)
03700	PDOT:	MOVE A,PACPTR-Q(A)
03800		INUM B,
03900		INUM C,
04000	
04100		JUMPL B,PDOT2	;CHECK BOUNDS OF PAC.
04200		JUMPL C,PDOT2
04300		CAIL  B,110
04400		JRST PDOT2
04500		CAIL C,110
04600		JRST PDOT2
04700	
04800		ASH C,1
04900		ADD A,C
05000		CAIL B,44
05100		JRST [	SUBI B,44
05200			AOS A
05300			JRST .+1]
05400		MOVEI D,43
05500		SUB   D,B	;BYTE POINTER P-FIELD.
05600		ROT   D,-6
05700		IOR   D,[POINT 1,PAC(1),35]
05800		SETO C,
05900		DPB C,D
06000	PDOT2:	SETZ 1,
06100		POPJ P,
     

00100	;(SEED PAC1 PAC2)
00200	;MOVE ONE BIT FROM PAC1 INTO PAC2.
00300	SEED:	
00350		MOVE C,CWPAC-Q(A)	;CHANGE CAMERA WINDOW OF PAC2
00375		MOVEM C,CWPAC-Q(B)
00387		MOVE A,PACPTR-Q(A)
00400		MOVE B,PACPTR-Q(B)
00500	
00600		MOVEI C,217
00700		SKIPE D,PAC(A)
00800		JRST .+5
00900		AOS A
01000		SOJGE C,.-3
01100		SETZ A,
01200		POPJ P,
01300	
01400		JFFO D,.+1
01500		MOVNS E
01600		HLLI E,
01700		HRLZI D,400000
01800	LSH D,@E
01900	SUBI C,217
02000	SUB B,C
02100	MOVEM D,PAC(B)
02200		SETZ A,
02300		POPJ P,
02400	
02500	
02600	
02700	
02800	
02900	;MOVE PAC1 INTO PAC2
03000	;(BLIT PAC1 PAC2)
03100	BLIT:	MOVE C,CWPAC-Q(A)	;CHANGE CAMERA WINDOW OF PAC2.
03150		MOVEM C,CWPAC-Q(B)
03175		HRLZ A,PACPTR-Q(A)
03200		HRR  A,PACPTR-Q(B)
03300		ADD A,[XWD PAC,PAC]
03400		HRRZ B,A
03500		ADDI B,217
03600		BLT A,@B
03700		SETZ A,
03800		POPJ P,
03900	
04000	;(BORDER PAC)
04100	BORDER:	MOVE A,PACPTR-Q(A)
04200		SETOM PAC    (A)
04300		SETOM PAC+1  (A)
04400		SETOM PAC+216(A)
04500		SETOM PAC+217(A)
04600		HRRZI B,1
04700		MOVEM B,PAC+3(A)
04800		ROT B,-1
04900		MOVEM B,PAC+2(A)
05000		HRRZ B,A
05100		ADDI B,PAC+215
05200		HRL  A,A
05300		ADD  A,[XWD PAC+2,PAC+4]
05400		BLT  A,@B
05500		SETZ A,
05600		POPJ P,
05700	;(INTIOR PAC)
05800	INTIOR:	MOVE A,PACPTR-Q(A)
05900		SETZM PAC    (A)
06000		SETZM PAC+1  (A)
06100		SETZM PAC+216(A)
06200		SETZM PAC+217(A)
06300		HRREI B,-2
06400		MOVEM B,PAC+3(A)
06500		ROT B,-1
06600		MOVEM B,PAC+2(A)
06700		HRRZ B,A
06800		ADDI B,PAC+215
06900		HRL  A,A
07000		ADD  A,[XWD PAC+2,PAC+4]
07100		BLT  A,@B
07200		SETZ A,
07300		POPJ P,
     

00100	;(XYFLIP PAC)
00200	;FLIPS THE CONTENTS OF PAC ABOUT THE X=Y AXIS
00300	XYFLIP:	MOVE A,PACPTR-Q(A)
00301		MOVE E,CWPAC(A)
00302		MOVEM E,CWPAC+20
00400		MOVE E,A
00500	
00600		ADD A,[POINT 1,PAC]
00700		MOVE B,[POINT 1,PAC20(C)]
00800		MOVEI D,107
00900	XYF0:	HRLZI C,-110
00950		IBP B
01000	XYF1:	ILDB F,A	;FROM PAC
01100		DPB F,B		;TO PAC 20
01200		AOS C
01300		AOBJN C,XYF1
01400		SOJGE D,XYF0
01401		SKIPE BLBFLG
01402		POPJ P,		;BLOB CALL EXIT.
01500	
01600	;MOVE PAC 20 TO PAC   IF NOT A CALL FROM BLOB SUBR.
01601	
01700		ADD E,[XWD PAC+20*220,PAC]
01800		HRRZ B,E
01900		ADDI B,217
02000		BLT E,@B
02100		SETZ A,
02200		POPJ P,
     

00100	;(PACO PAC  AW FLG) CW-PARAMETER AUTOMATED 1/2/70.
00200	;DISPLAY PAC ON ARDS
00300	;CW CAMERA WINDOW (CDX CX CDY CY) DEFAULT PAC'S CAMERA WINDOW
00400	;AW ARDS  WINDOW  (ADX AX ADY AY) DEFAULT (4 -1120 -4 1000)
00500	
00600	;DISPLAY WINDOW TRANSFORM
00700	;AX + (CX + X * CDX)*ADX
00800	;AY + (CY + Y * CDY)*ADY
00900	
01000	;(AX+CX*ADX) + X*(CDX * ADX)
01100	;(AY+CY*ADY) + Y*(CDY * ADY)
01200	
01300	;INITIALIZATION FROM ARGUMENTS
01400	PACO:	MOVEM C,BLBFLG#
01500	;XYFLIP ON FLAG.
01600		JUMPN C,[	MOVEM B,AC2
01700				PUSHJ P,XYFLIP
01800				MOVEI A,Q+20
01900				MOVE B,AC2
02000				JRST .+1]
02100		MOVEM B,C
02200		INUM A,
02300		MOVE B,A
02400		IMULI A,220
02500		HRLI A,-220
02600		CAIGE C,Q+40
02700		JRST [SKIPN C
02800		JRST [SKIPN BLBFLG
02900		MOVE C,AWNIL1↔JRST .+1
03000		MOVE C,AWNIL2↔JRST .+1]
03050		CAIGE C,Q-10 ↔ JRST .+1
03100		INUM C,
03200		MOVE C,AWTABL(C)
03300		JRST .+1]
03400	
03500		LDB D,[POINT 9,CWPAC(B),26]	;CDX
03600		HLRZ E,@C
03700		INUM E,
03800		IMUL D,E
03900		MOVEM D,DDX#
04000		IMULI D,44
04100		MOVEM D,DDX44#
04200	
04300		HRRZ C,@C
04400		LDB D,[POINT 9,CWPAC(B), 8]	;CX
04500		SUBI D,XLOTV
04600		HLRZ F,@C	;AX
04700		INUM F,
04800	
04900		IMUL D,E	;CX *ADX
05000		ADD D,F
05100		MOVEM D,XORG#
05200	
05300		HRRZ C,@C
05400		LDB D,[POINT 9,CWPAC(B),35]	;CDY
05500		HLRZ E,@C	;ADY
05600		INUM E,
05700		MOVE F,E
05800		IMUL F,D	;DDY
05900		
06000		HRRZ C,@C
06100		LDB B,[POINT 9,CWPAC(B),17]	;CY
06200		SUBI B,YLOTV
06300		HLRZ C,@C	;AY
06400		INUM C,
06500		IMUL B,E
06600		ADD B,C
06700		SKIPE BLBFLG
06800		EXCH B,XORG
06900		MOVEM B,YORG#
07000		SKIPE BLBFLG
07100		MOVNS XORG
07200		SKIPE BLBFLG
07300		MOVNS YORG
     

00100	;SCAN THRU PAC FOR NON-ZERO WORDS
00200		SKIPN B,PAC(A)
00300	BLB1:	JRST [	AOBJN A, [	TLNN A,1
00400					ADDM F,YORG
00500					JRST .-1]
00600			SETZM BLBFLG
00700			HRREI E,-1200
00800			HRREI D,-1100
00900			PUSHJ P,ADOT
01000			SETZ A,
01100			MOVE F,TEMP
01200			CLOSE 7,
01300			POPJ P,]
01400	
01500	;DISPLAY DOT AS AN ORIGIN FOR NON-ZERO WORD
01600	;XORG+(PARITY OF A LEFT)*44*DDX ,  YORG
01700		SETZ E,
01800		TLNE A,1
01900		MOVE E,DDX44	;ODD PARITY RIGHT SIDE
02000		ADD E,XORG
02100		MOVE D,YORG
02200		PUSHJ P,ADOT
02300	
02400	;PUT SECOND WORD IN  D
02500		SETZ D,
02600		TLNE A,1
02700		JRST .+3
02800		AOBJN A,.+1	;EVEN PARITY
02900		MOVE D,PAC(A)
03000	
03100	;FIND AND DISPLAY BITS IN A LINE
03200	BLB2:	JFFO B,BLB3
03300		SKIPN D	;NOTHING IN FIRST WORD
03400		JRST @BLB1	;ALL DONE WITH THIS LINE
03500		SETZ C,		;FIND BITS IN SECOND WORD
03600		JFFO D,.+1
03700		LSH D,@E
03800		MOVE B,D
03900		ADDI E,44
04000		JRST BLB4
04100	
04200	;SPACE OVER ZERO BITS
04300	BLB3:	JUMPE C,BLB5	;NO SPACES
04400		EXCH C,D
04500		LSHC B,@D
04600		MOVE E,D
04700	BLB4:	IMUL E,DDX
04800		SETZ D,
04900		PUSHJ P,NVEC
05000		MOVE D,C	;PUT SECOND WORD IN D  AGAIN
     

00100	;VECTOR DISPLAY
00200	;LEADING ONES ARE IN B,  SECOND WORD IN  D.
00300	BLB5:	MOVE C,D
00400		SETCM D,B	;FIND LENGTH OF VECTOR
00500		JFFO D,[LSHC B,@E ↔ JRST BLB6]
00600	;FIRST WORD WAS SOLID ONES
00700		SETCM D,C	;GET SECOND WORD
00800		JFFO D,.+2
00900		MOVEI E,44	;SECOND WORD WAS SOLID ONES TOO
01000		MOVE B,C	;ADVANCE THE BITS
01100		LSH B,@E
01200		SETZ C,
01300		ADDI E,44
01400	;DISPLAY VECTOR OF LENGTH FROM E
01500	BLB6:	IMUL E,DDX
01600		SETZ D,
01700		PUSHJ P,AVEC
01800		MOVE D,C
01900		JRST BLB2
02100	;(ARDDOT X Y)
02200	ARDDOT:	INUM A,
02300		INUM B,
02400		MOVE E,A
02500		MOVE D,B
02600		PUSHJ P,ADOT
02700		SETZ 1,
02800		POPJ P,
02900	;(ARDVEC X Y)
03000	ARDVEC:	INUM A,
03100		INUM B,
03200		MOVE E,A
03300		MOVE D,B
03400		PUSHJ P,AVEC
03500		SETZ 1,
03600		POPJ P,
03700	;(ARDEOF)
03800	ARDEOF:	CLOSE 7,
04000		SETZ 1,
04100		POPJ P,
04200	;(ARDNVC X Y)
04300	ARDNVC:	INUM A,
04400		INUM B,
04500		MOVE E,A
04600		MOVE D,B
04700		PUSHJ P,NVEC
04800		SETZ 1,
04900		POPJ P,
05000	;(ARDFF)
05100	ARDFF:	MOVEI E,14
05200		JSR PUTCHR
05300		SETZ 1,
05400		POPJ P,
05500		
05600	XDX←←3
05700	YDY←←3
05800	X0← -1100
05900	X1←  -440
06000	X2←     0
06100	X3←   440
06200	
06300	X4←X0-2*XDX
06400	X5←X1- XDX
06500	X6←X2
06600	X7←X3+XDX
06700	
06800	Y0←1200
06900	Y1← 540
07000	Y2← 100
07100	Y3 ←-340
07200	
07300	Y4←Y0+2*YDY
07400	Y5←Y1+  YDY
07500	Y6←Y2
07600	Y7←Y3-YDY
07700	
07800	;ARDS-WINDOW LIST
07900	DEFINE AWLIST(X,Y,D){
08000	[XWD Q+D,[XWD Q+X,[XWD Q-D,[XWD Q+Y,0]]]]
08400	
08500	}
08600	
08700	AWLIST X4,Y4,2
08800	AWLIST X6,Y4,2
08900	AWLIST X4,Y6,2
09000	AWLIST X6,Y6,2
09100	AWLIST X0,Y0,2
09200	AWLIST X2,Y0,2
09300	AWLIST X0,Y2,2
09400	AWLIST X2,Y2,2
09500	AWTABL:	AWLIST X0,Y0,1
09600	AWLIST X1,Y0,1
09700	AWLIST X2,Y0,1
09800	AWLIST X3,Y0,1
10000	AWLIST X0,Y1,1
10100	AWLIST X1,Y1,1
10200	AWLIST X2,Y1,1
10300	AWLIST X3,Y1,1
10500	AWLIST X0,Y2,1
10600	AWLIST X1,Y2,1
10700	AWLIST X2,Y2,1
10800	AWLIST X3,Y2,1
11000	AWLIST X0,Y3,1
11100	AWLIST X1,Y3,1
11200	AWLIST X2,Y3,1
11300	AWLIST X3,Y3,1
11400	AWLIST X4,Y4,1
11500	AWLIST X5,Y4,1
11600	AWLIST X6,Y4,1
11700	AWLIST X7,Y4,1
11800	AWLIST X4,Y5,1
11900	AWLIST X5,Y5,1
12000	AWLIST X6,Y5,1
12100	AWLIST X7,Y5,1
12200	AWLIST X4,Y6,1
12300	AWLIST X5,Y6,1
12400	AWLIST X6,Y6,1
12500	AWLIST X7,Y6,1
12600	AWLIST X4,Y7,1
12700	AWLIST X5,Y7,1
12800	AWLIST X6,Y7,1
12900	AWLIST X7,Y7,1
13000	;TVBUF -5
13100	;COLORS (-1,3)(-2,2)(-3,1)(-4,0)
13200	;PAC 0 THRU 25
13300	;CAMERA WINDOW GET. (CWGET N).
13400	CWGET:	MOVE A,CWPAC-Q(A)
13500		JCALL 1,FIX1A
13600	;CAMERA WINDOW PUT.
13700	;(CWPUT X Y DX DY N)
13800	CWPUT:	INUM A,
13900		INUM B,
14000		INUM C,
14100		INUM D,
14200		INUM E,
14300		MOVEM D,CWPAC(E)
14400		HRLM  B,CWPAC(E)
14500		DPB   A,[POINT 9,CWPAC(E),8]
14600		DPB   C,[POINT 9,CWPAC(E),26]
14700		SETZ 1,
14800		POPJ P,
     

00100	;(ZOOM PAC P Q dx dy)
00200	;CALLS (WINDOW  PACX+P*DX-44*dx   PACY+Q*DY-44*dy  dx  dy)
00300	ZOOM:	INUM A,
00400		INUM B,				;P
00500		INUM C,				;Q
00600		INUM D,				;dx
00700		INUM E,				;dy
00800		LDB 10,[POINT 9,CWPAC(A),26]	;DX
00900		LDB 11,[POINT 9,CWPAC(A),35]	;DY
01000		IMUL B,10			;P*DX
01100		IMUL C,11			;Q*DY
01200		MOVE 12,D
01300		MOVE 13,E
01400		IMULI D,44			; 44*dy
01500		IMULI E,44			; 44*dy
01600		LDB F,[POINT 9,CWPAC(A),8]	;PACX
01700		LDB G,[POINT 9,CWPAC(A),17]	;PACY
01800		ADD F,B
01900		ADD G,C
02000		SUB F,D
02100		SUB G,E
02200		MOVE A,F	;X
02300		MOVE B,G	;Y
02400		MOVE C,12	;dx
02500		MOVE D,13	;dy
02600		CAIGE A,XLOTV
02700		MOVEI A,XLOTV
02800		CAIGE B,YLOTV
02900		MOVEI B,YLOTV
03000		JRST WINDOW+4
03100	
03200	
03300	AWNIL1:	AWLIST -1111,1224,4
03400	AWNIL2:	AWLIST -1111,1200,4
     

00100	;ARDS DRIVER FOR BLOB DISPLAY
00200	;ARGUMENTS X & Y IN ACCUMULATORS E & D RESPECTIVELY.
00300	ADOT:	EXCH E,[35]↔JSR PUTCHR↔EXCH E,[35]
00400		HLLZS CHRCON
00500		SKIPE BLBFLG
00600		JRST [MOVNS D ↔ MOVNS E ↔ EXCH D,E ↔ JRST .+1]	;X - Y - FLIP
00700		HRL D,E
00800		PUSHJ P,ARDS
00900		EXCH E,[36]↔JSR PUTCHR↔EXCH E,[36]
01000		POPJ P,
01100	NVEC:	HLRS CHRCON
01200		SKIPA
01300	AVEC:	HLLZS CHRCON
01400		SKIPE BLBFLG
01500		JRST [MOVNS D ↔ MOVNS E ↔ EXCH D,E ↔ JRST .+1]	; X - Y - FLIP
01600		CAIL D,2000
01700		JRST ARD2
01800		CAIL E,2000
01900		JRST ARD2
02000		CAMG D,[-2000]
02100		JRST ARD2
02200		CAMG E,[-2000]
02300		JRST ARD2
02400		HRL D,E
02500		PUSHJ P,ARDS
02600		POPJ P,
02700	;VECTOR TOO LONG FOR ONE ARDS-VECTOR
02800	ARD2:	MOVEM E,TEMPX#
02900		MOVEM D,TEMPY#
03000		ASH E,-1
03100		ASH D,-1
03200		SUBM E,TEMPX
03300		SUBM D,TEMPY
03400		HRL D,E
03500		PUSHJ P,ARDS
03600		MOVN D,TEMPY
03700		MOVN E,TEMPX
03800		HRL D,E
03900		PUSHJ P,ARDS
04000		POPJ P,
04100	CHRCON:	XWD 40,0	;CONTROL CHARACTER
     

00100	;GENERATE ASCII FOR ARDS GRAPHICS
00200	DEFINE CHARD (N,M,P) {
00300	IFE (N-1)*(N-2),<HLRE E,D>
00400	IFE (N-3)*(N-4),<HRRE E,D>
00500	MOVMS E
00600	ASH E,M
00700	IFE (N-1),<TLNE D,400000>
00800	IFE (N-3),<TRNE D,400000>
00900	IFE (N-1)*(N-3),<TRO E,1>
01000	ANDI E,P
01100	IORI E,100
01200	IFE (N-2),<IOR E,CHRCON>
01300	JSR PUTCHR}
01700	ARDS:	CHARD 1,1,77
01800		CHARD 2,-5,37
01900		CHARD 3,1,77
02000		CHARD 4,-5,37
02100		POPJ P,
02300	;INITIALIZE ARDS
02400	;(INARDS)
02402	INARDS:	SETZM ARDBUF		;CLEAR AND RESET BUFFERS
02404		MOVE A,[XWD ARDBUF,ARDBUF+1]
02406		BLT A,PUTCHR-1
02408		MOVE A,[XWD 26,BUF2+1]
02410		MOVEM A,BUF1+1
02412		HRRI  A,BUF3+1	↔ MOVEM A,BUF2+1
02414		HRRI  A,BUF1+1  ↔ MOVEM A,BUF3+1
02500		INIT 7,0
02600		SIXBIT/TTY10/
02700		XWD ARDBUF,0
02800		JRST INARD2
02900		MOVE 1,[XWD 400000,BUF1+1]
03000		MOVEM 1,ARDBUF
03100		MOVE 1,[POINT 7,0,35]
03200		MOVEM 1,ARDBUF+1
03300	INARD2:	SETZ 1,
03400		POPJ P,
03500	ARDBUF: BLOCK 3
03600	BUF1:	0↔XWD 26,BUF2+1↔BLOCK 30
03700	BUF2:	0↔XWD 26,BUF3+1↔BLOCK 30
03800	BUF3:	0↔XWD 26,BUF1+1↔BLOCK 30
04100	PUTCHR:	0
04200		SOSLE ARDBUF+2
04300		JRST PUTOK
04400		OUTPUT 7,
04500		STATZ 7,740000
04600		HALT
04700	PUTOK:	IDPB E,ARDBUF+1
04800		JRST @PUTCHR
     

00100	;(PACLST PAC)
00200	PACLST:	MOVE C,PACPTR-Q(A)
00300		SETZ G,
00400		SETZ H,
00500		SETZ A,
00600		SKIPN D,PAC(C)
00700		JRST [SKIPE E,PAC+1(C)
00800			JRST [
00900	PCLST0:			MOVEI A,Q	;ROW-LIST.
01000				ADD  A,G
01100				SETZ B,		;NIL.
01200				CALL 2,CONS
01300				MOVE B,A
01400				MOVEI F,Q
01500				MOVEM F,PCLSTX#
01600				JRST .+3]
01700	PCLST1:		CAIN G,107
01800			POPJ P,
01900			AOS G
02000			ADDI C,2
02100			JRST .-1]
02200		MOVE E,PAC+1(C)
02300		JRST PCLST0
02400	
02500		EXCH D,E
02600		JFFO E,[EXCH D,E
02700		LSHC D,@F
02800		LSHC D,1
02900		ADDB F,PCLSTX#
02950		AOS PCLSTX
03000		MOVE A,F
03100		CALL 2,CONS
03200		MOVE B,A
03300		JRST .-1]
03400	
03500		SKIPE E,D	;CHECK FOR ANY BITS IN 2ND WORD OF ROW.
03600		JRST [SETZ D,
03700			MOVEI F,44
03800			ADDM F,PCLSTX
03900			JRST .-2]
04000	
04100		MOVE A,B
04200		MOVE B,H
04300		CALL 2,CONS
04400		MOVE H,A
04500		JRST PCLST1
     

00100	;(GREY PAC COLOR XORG YORG)
00200	;MOVES COLOR INTO PAC FOR GREY LEVEL DISPLAY.
00210	GREYBP:	POINT 4,COLORS,8
00220		POINT 4,COLORS,17
00230		POINT 4,COLORS,26
00240		POINT 4,COLORS,35
00300	GREY:	MOVE A,PACPAC-Q(A)
00400		MOVE B,GREYBP-Q(B)
00500		INUM C,
00600		INUM D,
00700		IMULI D,110
00800		ADD B,C
00900		ADD B,D
01000		MOVEM AC0	;SAVE ACCUMULATOR 0.
01100		MOVEI 21
01200		MOVEM AC1	;OUTER LOOP COUNTER
01300	GREY0:	MOVEI 3,21	;INNER LOOP COUNTER
01400		SETZ 4,		;CLEAR EIGHT ACCUMULATORS
01500		MOVE [XWD 4,5]
01600		BLT 13
01700	GREY1:	LDB B
01800		AOS B
01900		JUMPE GREY2	;MINIMUM INTENSITY CASE.
02000		AOS
02100		CAIE 20
02200		JRST .+6
02300		IORI 5,17	;MAXIMUM INTENSITY CASE.
02400		IORI 7,17
02500		IORI 11,17
02600		IORI 13,17
02650		JRST GREY2
02700		TRNE 1		;INTERMEDIATE INTENSITY CASES.
02800		IORI 5,1
02900		TRNE 2
03000		IORI 5,6
03100		TRNE 4
03200		IORI 11,17
03300		TRNN 10
03400		JRST .+3
03500		IORI 7,17
03600		IORI 13,17
03700	GREY2:	ROTC 4,4
03800		ROTC 6,4
03900		ROTC 10,4
04000		ROTC 12,4
04100		SOJGE 3,GREY1	;INNER LOOP.
04200		ROTC 4,-4
04300		ROTC 6,-4
04400		ROTC 10,-4
04500		ROTC 12,-4
04600		MOVE A		;PUT IN PAC
04700		HRLI 4
04900		ADDI A,7
05000		BLT @A
05100		AOS A
05200		SOSGE AC1	;OUTER LOOP
05300		JRST [MOVE AC0↔SETZ 1,↔POPJ P,]
05400		ADDI B,110-22
05500		JRST GREY0
05600	DEFINE GRYMAC(YY,XX,PAC){
05700		MOVEI A,PAC+Q
05800		MOVE B,AC2
05900		MOVEI C,XX+Q
06000		MOVEI D,YY+Q
06100		PUSHJ P,GREY
06200	}
06300	;(GRAY N)  HIT GREY SIXTEEN TIMES FOR COLOR N AND ALLPAC.
06400	GRAY:	MOVEM A,AC2
06500	
06600		GRYMAC 0,0,0
06700		GRYMAC 0,22,1
06800		GRYMAC 0,44,2
06900		GRYMAC 0,66,3
07000		GRYMAC 22,0,4
07100		GRYMAC 22,22,5
07200		GRYMAC 22,44,6
07300		GRYMAC 22,66,7
07400		GRYMAC 44,0,10
07500		GRYMAC 44,22,11
07600		GRYMAC 44,44,12
07700		GRYMAC 44,66,13
07800		GRYMAC 66,0,14
07900		GRYMAC 66,22,15
08000		GRYMAC 66,44,16
08100		GRYMAC 66,66,17
08200		POPJ P,
     

00100		BEGIN TSERVO
00200		A1←1
00300		;REGISTERS AVAILABLE TO USER
00400		Z←←0
00500	
00600		↑STATUS:	Z;	STATUS BITS
00700		FLAG:	Z;	NON-ZERO IF SERVOING
00800		COUNT:	Z;	LENS CHANGE COUNTER
00900		↑P1:	Z;	LATEST POT READING - FOCUS
01000		↑P2:	Z;	TILT
01100		↑P3:	Z;	PAN
01200		X1:	Z;	PREVIOUS POT READING
01300		X2:	Z
01400		X3:	Z
01500		↑L1:	Z;	FINAL POT VALUES
01600		↑L2:	Z
01700		↑L3:	Z
01800		E1:	4;	TOLERANCES
01900		E2:	10
02000		E3:	10
02100	
02200		;REGISTERS FOR INTERNAL USE ONLY
02300		.DEL:	25;	COUNTER FOR HUNG A-D
02400		.MCNT:	300;	LENS COUNT
02500		.MCNTX:	240;	LENS MOTOR CUTOFF
02600		.MISSD:	100;	DATA MISSED COUNT
02700		.CNTR:	40;	STOP COUNTER MAX
02800	
02900		;STATUS DITS
03000		.DONE←←1
03100		.RUN←←2
03200		.HUNG←←20
03300		.STOP←←10
03400		.LENS←←4
03500		.MISS←←40
03600	
03700		;RELAY BITS
03800		.P1P←←20000;	FOCUS NEAR
03900		.P1M←←10000;	FOCUS FAR
04000		.P2M←←400000;	TILT UP
04100		.P2P←←200000;	TILT DOWN
04200		.P3M←←40000;	PAN CW
04300		.P3P←←100000;	PAN CCW
04400		.XLENS←←4000
04500	;CONSTANTS
04600	
04700		.AD←←424
04800		.DATA←←204
04900		.MISC←←700
05000		.REL←←40
05100		OPDEF SPCWAR[43B8]
05200	
05300	↑TSERVO:	MOVE 17,STATUS;		FIXUP STATUS BITS
05400			ANDCMI 17,.HUNG+.MISS
05500			ORI 17,.RUN
05600			SETZM FLAG
05700			SETZM 16;
05800			TRNN 17,.DONE
05900			JRST .LAB1
06000			SETZM COUNT
06100			CONO .MISC,.REL
06200			MOVEM 17,STATUS
06300			CALL
06400	
06500		.LAB1:	TRZN 17,.LENS
06600			JRST .LAB2
06700			MOVE .MCNT
06800			ADDM COUNT
06900		.LAB2:	TRNE 17,.STOP
07000			JRST .LABD
07100			CONI .DATA,1
07200			ANDI 1,7
07300			CONO .DATA,4250
07400			CONO .AD,172000
07500			MOVE 4,.MISSD
07600			MOVE 3,.DEL
07700			CONI .DATA,2
07800			TRNE 2,11000
07900			JRST .+3
08000			SOJG 3,.-3
08100			JRST .HANG
08200			TRNN .DATA,10000
08300			JRST .+3
08400			SOJG 4,.-10
08500			JRST .DMISS
08600			DATAI .DATA,5
08700			CONO .AD,4111
08800			CONO .DATA,203560(1)
08900			ASHC 5,-30
09000			LSH 6,1
09100			ASHC 6,-30
09200			LSH 7,1
09300			ASH 7,-30
09400	MOVE 10,[XWD 5,P1]
09500			BLT 10,P3
09600			SUB 5,L1
09700			SUB 6,L2
09800			SUB 7,L3
09900			MOVM 11,5
10000			MOVM 12,6
10100			MOVM 13,7
10200			CAMGE 11,E1
10300		JRST .LAB3
10400			JUMPG 5,.+2
10500			TROA 16,.P1M
10600			ORI 16,.P1P
10700			SETOM FLAG
10800		.LAB3:	CAMGE 12,E2
10900			JRST .LAB4
11000			JUMPG 6,.+2
11100			TROA 16,.P2M
11200			ORI 16,.P2P
11300			SETOM FLAG
11400		.LAB4:	CAMGE 13,E3
11500			JRST .LAB5
11600			JUMPG 7,.+2
11700			TROA 16,.P3M
11800			ORI 16,.P3P
11900			JRST .LAB6
12000	
12100		.LAB5:	SKIPN FLAG
12200			JRST .LABD
12300		.LAB6:	MOVS 10,[XWD 5,P1]
12400			BLT 10,7
12500			SUB 5,X1
12600			SUB 6,X2
12700			SUB 7,X3
12800			MOVMS 5
12900			MOVMS 6
13000			MOVMS 7
13100			SUB 5,E1
13200			SUB 6,E2
13300			SUB 7,E3
13400			AND 5,6
13500			AND 5,7
13600			JUMPGE 5,.LAB10
13700			AOS 15,.SCNT
13800			CAMGE 15,.CNTR
13900			JRST .LAB11
14000			SETZM 16
14100			ORI 17,.STOP+.DONE
14200			JRST .+5
14300	.HANG:	TROA 17,.HUNG+.DONE
14400		.DMISS:	ORI 17,.MISS+.DONE
14500			CONO .AD,4000
14600			CONO .DATA,203560(1)
14700			SETZM COUNT
14800			SETZM .SCNT#
14900			JRST .LABB
15000	
15100		.LABD:	SKIPN COUNT
15200			ORI 17,.DONE
15300		.LAB10:	MOVE 10,[XWD P1,X1]
15400			BLT 10,X3
15500			SETZM .SCNT
15600		.LAB11:	MOVE 15,COUNT
15700			CAMLE 15,.MCNTX
15800			ORI 16,.XLENS
15900		.LABB:	CONO .MISC,.REL(16)
16000			JUMPLE 15,.+2
16100			SOS COUNT
16200			MOVEM 17,STATUS
16300			CALL
16400	
16500		FLUSH:	CONO .MISC,.REL
16600			SETOM FL#
16700			CALL
16800		BEND
     

00100	BEGIN CARCON
00200	P←14
00300	Q←16
00400	QQQ←577777
00500	Z←0
00600	CMD←14
00700	EXTERNAL EXP
00800	OPDEF FIX6 [120B8]
00900	OPDEF FIX [247B8]
01000	↑HIND:	INUM 1,QQQ	↔ MOVEM 1,BKANG   ↔JRST CARCAR
01100	↑FORE:	INUM 1,QQQ	↔ MOVEM 1,FRANG   ↔JRST CARCAR
01200	↑HEAD:	INUM 1,QQQ	↔ MOVEM 1,CAMANG  ↔JRST CARCAR
01300	↑STOP:	SETZM DRCMD     ↔JRST CARCAR
01400	↑RUN:	AOS DRCMD ↔JRST CARCAR
01500	
01600	CARCAR:	SETOM FLAG ↔ SPCWAR 1,CCOMP ↔ SKIPE FLAG ↔ JRST .-1
01700		SPCWAR 636367 ↔ SETZ 1, ↔ POPJ P,
01800	
01900	↑CARCON:	SETZM JSTOP
02000		SETOM FLAG
02100		SPCWAR 1,ONCE
02200		SKIPE FLAG
02300		JRST .-1
02400		SPCWAR 636367
02500		SETZ 1,
02600		POPJ P,
02700	FLAG:	Z
02800	ONCE:	CONO 700,624054	;STOP THE CART
02900		CONO 700,450050
03000		CONO 700,450055	;SET UP UNUSED DACS
03100		SETZM DRCMD
03200		SETZM FLAG
03300		CALLI
03400	JSTOP:	Z
03500	DISMIS:	Z
03600	FRANG:	Z
03700	BKANG:	Z
03800	CAMANG:	Z
03900	DRCMD:	Z
04000	BKW51:	XWD 51,0
04100	CAM52:	XWD 52,0
04200	FRW53:	XWD 53,0
04300	DR54:	XWD 54,0
04400	VSUP:	9.8
04500	VBE:	0.68
04600	RC:	4.76E-3  ↔  	4.8E-3   ↔ 	5.85E-3
04700	CPULS:	1.791E-3
04800	CPMAX:	2.3E-3   ↔	2.27E-3  ↔	2.27E-3
04900	EPS:	-0.99 ↔	-0.54 ↔	-0.7
05000	PULSW:	Z
     

01200	PULSE:	0	;CALCULATES DAC VOLTAGE TO MAKE GIVEN WIDTH
01300		MOVE 2,PULSW	;FORMULA IS:
01400		FDV 2,RC(1)	;V(DAC)=2*SUPPLYVOLTAGE+EPSILON-(VSUPPLY-VBE)*E**(PULSW/RC)
01500		JSA Q,EXP
01600		2
01700		MOVE 3,VSUP
01800		FSB 3,VBE
01900		FMP 3,0
02000		MOVE 2,VSUP
02100		FSC 2,1
02200		FAD 2,EPS(1)
02300		FSB 2,3
02400		FMP 2,[102.4]	;MAKES DAC NUMBER FROM VOLTAGE
02500		FIX6 2,233000	;FIX IT	,THIS LOC IS MODIFIED BY THE PROG.
02600		DPB 2,[POINT 10,BKW51(1),27]
02700		JRST @PULSE
02800	
02900	
03000	
03100	
03200	
03300	CCOMP:	MOVE 2,BKANG		;CCOMP CONTAINS THE ALGORITHM FOR COMPUTING DAC
03400		MOVM 3,2	;LAST CHECK OF ANGLE
03500		CAILE 3,=360	;TOO BIG?
03600		MOVEI 2,=360
03700		FSC 2,233	;FLOAT THE ANGLE
03800		FDV 2,[360.0]	;GET FRACTION OF TOTAL ROTATION
03900		MOVE 3,CPULS	;CENTER WIDTH
04000		FSB 3,CPMAX	;TOTAL DELTA WIDTH
04100		FMP 2,3		;FOR THIS ANGLE
04200		FAD 2,CPULS	;GET TOTAL WIDTH
04300		MOVEM 2,PULSW
04400		MOVEI 1,0
04500		JSR PULSE
04600		MOVE 2,FRANG		;THIS ROUTINE RUNS IN SPCWAR MODE
04700		MOVM 3,2	;LAST CHECK OF FRONT
04800		CAILE 3,=360	;TOO BIG?
04900		MOVEI 2,=360
05000		FSC 2,233	;FLOAT THE ANGLE
05100		FDV 2,[360.0]	;GET FRACTION OF TOTAL ROTATION
05200		MOVE 3,CPULS	;CENTER WIDTH
     

00100		FSB 3,CPMAX+2	;TOTAL DELTA WIDTH
00200		FMP 2,3		;FOR THIS ANGLE
00300		FAD 2,CPULS	;GET TOTAL WIDTH
00400		MOVEM 2,PULSW
00500		MOVEI 1,2
00600		JSR PULSE
00700		MOVE 2,CAMANG
00800	CAMCK:	CAILE 2,=270
00900		JRST CAM1
01000		CAMGE 2,[-=90]
01100		JRST CAM2
01200		MOVEM 2,CAMANG
01300		SUBI 2,=90	;CHANGE RANGE TO +/-180
01400		MOVM 3,2	;LAST CHECK ON CAMERA
01500		CAILE 3,=180	;TOO BIG?
01600		MOVEI 2,=180
01700		FSC 2,233	;FLOAT THE ANGLE
01800		FDV 2,[180.0]	;GET FRACTION OF TOTAL ROTATION
01900		MOVE 3,CPULS	;CENTER WIDTH
02000		FSB 3,CPMAX+1	;TOTAL DELTA WIDTH
02100		FMP 2,3		;FOR THIS ANGLE
02200		FAD 2,CPULS	;GET TOTAL WIDTH
02300		MOVEM 2,PULSW
02400		MOVEI 1,1
02500		JSR PULSE
02600		MOVEI 2,500000	;HERE CALCULATE DRIVE VOLTAGE
02700		SKIPN DRCMD
02800		ADDI 2,40000	;DRCMD=1 OR 2 MEANS GO
02900		HRRM 2,DR54
03000		DATAO 700,BKW51
03100		DATAO 700,CAM52
03200		DATAO 700,FRW53
03300		DATAO 700,DR54
03400		SETZM FLAG
03500		CALLI
03600	
03700	CAM1:	SUBI 2,=180
03800		JRST CAMCK
03900	CAM2:	ADDI 2,=180
04000		JRST CAMCK
04100	BEND CARCON